Visual Basic 5 Developer's Kit/vb5 dev kit.iso/dev/desaware/spyworks/coop1.frm

Visual Basic Form | 1996-03-24 | 7.5 KB | 238 lines

VERSION 4.00
Begin VB.Form Coop1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Coop1"
   ClientHeight    =   2115
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   5010
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   2520
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   2115
   ScaleWidth      =   5010
   Top             =   1140
   Width           =   5130
   Begin VB.CommandButton ExitBut
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Exit"
      Height          =   465
      Left            =   3240
      TabIndex        =   6
      Top             =   1200
      Width           =   1665
   End
   Begin VB.TextBox TotalText
      Height          =   315
      Left            =   870
      MaxLength       =   12
      TabIndex        =   5
      Text            =   "123456"
      Top             =   1290
      Width           =   1245
   End
   Begin VB.TextBox AmountText
      Height          =   315
      Left            =   870
      MaxLength       =   12
      TabIndex        =   4
      Text            =   "7.75"
      Top             =   900
      Width           =   1245
   End
   Begin VB.TextBox CountText
      Height          =   315
      Left            =   870
      MaxLength       =   4
      TabIndex        =   3
      Text            =   "249"
      Top             =   510
      Width           =   1245
   End
   Begin VB.TextBox CompanyText
      Height          =   315
      Left            =   870
      MaxLength       =   24
      TabIndex        =   2
      Text            =   "Desaware SpyWorks Pro"
      Top             =   120
      Width           =   2265
   End
   Begin VB.CommandButton SendMessBut
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Send Message"
      Height          =   465
      Left            =   3240
      TabIndex        =   1
      Top             =   660
      Width           =   1665
   End
   Begin VB.CommandButton LaunchBut
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Launch New App"
      Height          =   465
      Left            =   3240
      TabIndex        =   0
      Top             =   120
      Width           =   1665
   End
   Begin Cbkd.Callback Callback1
      Left            =   2550
      Top             =   1140
      _Version        =   262144
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      Type            =   6
      IntVersion      =   5
   End
   Begin VB.Label Label2
      Height          =   285
      Left            =   120
      TabIndex        =   11
      Top             =   1740
      Width           =   4785
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "Long"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   3
      Left            =   120
      TabIndex        =   10
      Top             =   1320
      Width           =   705
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "Single"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   2
      Left            =   60
      TabIndex        =   9
      Top             =   930
      Width           =   765
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "Integer"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   8
      Top             =   540
      Width           =   705
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "String"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   150
      TabIndex        =   7
      Top             =   150
      Width           =   675
   End
Attribute VB_Name = "Coop1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim NewShellApp As Long
Dim OtherAppMainWindowHwnd As Long
Dim PrivateCoopMessage As Long
Private Sub Callback1_EnumWindows(hwnd As Long, lpData As Long, retval As Long)
Dim threadid As Long, processid As Long, res As Long
Dim ClassName As String
    ' Check if this window is part of the process we launched
    threadid = GetWindowThreadProcessId(hwnd, processid)
    ' The default return value is already TRUE to continue enumeration
    If processid <> NewShellApp Then Exit Sub
    ClassName = String$(32, 0)
    res = GetClassName(hwnd, ClassName, Len(ClassName) - 1)
    ClassName = Left$(ClassName, InStr(1, ClassName, Chr$(0)) - 1)
    If ClassName = THUNDERRTMAIN Then Exit Sub
    ' Stop the enumeration once we find the window
    retval = 0
    OtherAppMainWindowHwnd = hwnd
    label2.Caption = Hex$(hwnd)
End Sub
Private Sub ExitBut_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    PrivateCoopMessage = RegisterWindowMessage(COOP_MESSAGE)
End Sub
Private Sub LaunchBut_Click()
Dim res As Integer
    NewShellApp = Shell(App.Path & "\COOP2.EXE", 1)
    ' If Shell was successful then
    If NewShellApp Then
        ' Get the top level window handle of the newly launched application
        res = EnumWindows(Callback1.ProcAddress, 0)
    End If
End Sub
Private Sub SendMessBut_Click()
Dim cs As CoopStructure
Dim wp As Long, lp As Long, lres As Double, threadid As Long
    If PrivateCoopMessage Then
        ' Note that the Max length of CompanyText is
        ' set to the size of the CompanyName element.
        ' The other Text controls also have limited Max
        ' length to prevent overflow.
        lp = dwGetAddressForObject(cs.CompanyName(1))
        dwCopyDataByString CompanyText.Text, lp, 24

        ' Prevent invalid data type
        On Error GoTo InvalidCount
        cs.count = CInt(CountText.Text)
        On Error GoTo InvalidAmount
        cs.Amount = CSng(AmountText.Text)
        On Error GoTo InvalidTotal
        cs.Total = CLng(TotalText.Text)
        ' Turn off error checking
        On Error GoTo 0

        ' Get address of the structure and send it to the other application.
        lp = dwGetAddressForObject(cs)
        ' get process id to send
        threadid = GetWindowThreadProcessId(hwnd, wp)
        lres = SendMessageBynum(OtherAppMainWindowHwnd, PrivateCoopMessage, wp, lp)
        label2.Caption = Hex$(lres)
    End If
    Exit Sub
InvalidCount:
    cs.count = 0
    Resume Next
InvalidAmount:
    cs.Amount = 0
    Resume Next
InvalidTotal:
    cs.Total = 0
    Resume Next
End Sub